home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0687.arc / COMPRES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-25  |  1.6 KB  |  55 lines
  1.  
  2. {COMPRESS.PAS is a procedure written in Turbo Pascal for the IBM PC
  3.  and its compatibles for the purpose of compressing screen data.
  4.  It is not a stand-alone program.}
  5.  
  6. procedure Compress;
  7.  
  8. const escapechar = $F800;
  9.     scrnseg  = $B800;
  10.     scrnsize = 4000;
  11.  
  12. var OutputFile: Text;
  13.     OutputFileName: string[80];
  14.     runlength,currentword,nextword,scrnofs,items: integer;
  15.  
  16. begin
  17.   OutputFileName := paramSTR(1);
  18.   Assign(OutputFile, OutputFileName);
  19.   Rewrite(OutputFile);
  20.   write(OutputFile,'(');
  21.   items := 0;
  22.   scrnofs := 0;
  23.   currentword := MemW[scrnseg:scrnofs];   {read word from screen memory}
  24.   scrnofs := scrnofs + 2;
  25.   repeat
  26.     runlength := 0;
  27.     repeat
  28.       nextword := MemW[scrnseg:scrnofs];
  29.       scrnofs := scrnofs + 2;
  30.       runlength := runlength + 1;
  31.     until (nextword <> currentword) or (scrnofs > scrnsize);
  32.     if runlength > 1
  33.     then begin                       {it's count/value}
  34.       runlength := escapechar or runlength;       {set 'escape' bits}
  35.       write(OutputFile,runlength,',',currentword,',');
  36.       if (items mod 12) >= 10               {format into lines}
  37.     then writeln(OutputFile);
  38.       items := items + 2
  39.     end
  40.     else begin                       {it's a singleton}
  41.       write(OutputFile,currentword,',');
  42.       if (items mod 12) >= 11
  43.     then writeln(OutputFile);
  44.       items := items + 1
  45.     end;
  46.     currentword := nextword
  47.   until scrnofs > scrnsize;
  48.   write(OutputFile,'*** ',items,' items ***);');
  49.   Close(OutputFile);
  50.   writeln('Compressed data written to ',OutputFileName)
  51. end;
  52. OutputFile,'*** ',items,' items ***);');
  53.   Close(OutputFile);
  54.   writeln('Compressed data written to ',OutputFileName)
  55. end